home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / Modes / htmlElems.tcl < prev    next >
Text File  |  1996-08-15  |  25KB  |  920 lines
  1. #===============================================================================
  2. # 
  3. #    htmlElems.tcl (called by html.tcl)
  4. #
  5. #    Part of HTML mode 1.2
  6. #
  7. #    Macros for HTML elements.
  8. #
  9. #    Author: Johan Linde <jl@theophys.kth.se>
  10. #
  11. #    If you make improvements to this file, please share them!
  12. #
  13. #===============================================================================
  14.  
  15.  
  16. #
  17. # <P>
  18. #
  19.  
  20. proc htmlElemParagraph {{attr ""}} {
  21.     global HTMLmodeVars
  22.     set pIsContainer    $HTMLmodeVars(pIsContainer)
  23.     
  24.     if ($pIsContainer) { 
  25.         htmlBuildCR2Elem P $attr
  26.     } else {
  27.         htmlBuildOpening P 1 1 $attr
  28.     }
  29. }
  30.  
  31.  
  32. # Insert a <BR> in the end of every line in selection.
  33.  
  34. proc htmlInsertLineBreaks {} {
  35.     if {![isSelection]} {
  36.         beep
  37.         message "No selection."
  38.         return
  39.     }
  40.     
  41.     foreach ln [split [string trimright [getSelect] "¥r"] "¥r"] {
  42.         append text "${ln}[htmlSetCase <BR>]¥r"
  43.     }
  44.     replaceText [getPos] [selEnd] $text
  45. }
  46.  
  47. # Remove all <BR> in selection.
  48. proc htmlRemoveLineBreaks {} {
  49.     if {![isSelection]} {
  50.         beep
  51.         message "No selection."
  52.         return
  53.     }
  54.     
  55.     regsub -all "<(b|B)(r|R)(¥[ ¥t¥r¥]+¥[^>¥]*>|>)" [getSelect] "" text
  56.     if {$text != [getSelect]} {
  57.         replaceText [getPos] [selEnd] $text
  58.     }
  59. }
  60.  
  61. # Insert <P> at empty lines in selection, and in the beginning of the selection.
  62. # Several empty lines are contracted to one.
  63. proc htmlInsertParagraphs {} {
  64.     global HTMLmodeVars
  65.     if {![isSelection]} {
  66.         beep
  67.         message "No selection."
  68.         return
  69.     }
  70.     
  71.     set pIsContainer $HTMLmodeVars(pIsContainer)
  72.     
  73.     set oelem [htmlOpenElem P]
  74.     if {![string length $oelem]} {return}
  75.     
  76.     set text "¥r$oelem¥r"
  77.     set prevLineEmpty 1
  78.     
  79.     foreach ln [split [string trim [getSelect] "¥r"] "¥r"] {
  80.         regexp {[ ¥t]*} $ln lntest
  81.         # Only add <P> if previous line was not empty.
  82.         if {$ln == $lntest && !$prevLineEmpty} {
  83.             set prevLineEmpty 1
  84.             if {$pIsContainer} {
  85.                 append text "[htmlCloseElem P]¥r¥r$oelem¥r"
  86.             } else {
  87.                 append text "¥r$oelem¥r"
  88.             }
  89.         } else {
  90.             # Skip an empty line which follows another empty line.
  91.             if {$ln != $lntest} {
  92.                 set prevLineEmpty 0
  93.                 append text "$ln¥r"
  94.             }
  95.         }
  96.     }
  97.     if {$pIsContainer} {
  98.         append text "[htmlCloseElem P]¥r¥r"
  99.     }
  100.     
  101.     replaceText [getPos] [selEnd] $text
  102. }
  103.  
  104.  
  105. # Ask for input how to build a list. Returns "number of items" and
  106. # "ask for list item attributes". Returns "" if canceled or any problem.
  107. proc htmlListQuestions {ltype liattr lipr} {
  108.     global HTMLmodeVars
  109.     
  110.     set promptNoisily $HTMLmodeVars(promptNoisily)
  111.     if {[string length $liattr]} {
  112.         set optatts [htmlGetOptional $liattr]
  113.         set usedatts [htmlGetUsed $liattr]
  114.         set askForMore [htmlGetAttrMore $liattr]
  115.     } else {
  116.         set optatts ""
  117.         set askForMore [htmlGetAttrMore LI]
  118.         set usedatts [htmlGetUsed LI]
  119.     }
  120.     if {$lipr != "LI"} { 
  121.         set optatts [concat $optatts [htmlGetOptional DD]]
  122.         set usedatts [concat $usedatts [htmlGetUsed DD]]
  123.         if {!$askForMore} {set askForMore [htmlGetAttrMore DD]}
  124.     }
  125.     if {$HTMLmodeVars(useBigWindows)} {
  126.         set it {0 0 3 0}
  127.         while {1} {
  128.             set txt "dialog -w 280 -h 130 -b OK 20 100 75 120 -b Cancel 110 100 165 120 ¥
  129.             -t {$ltype list} 100 10 250 30 ¥
  130.             -t {How many items?} 10 40 150 60 -e [list [lindex $it 2]] 160 40 180 55"
  131.             if {[llength $optatts]} {
  132.                 append txt " -c {Ask for attributes for each $lipr} [lindex $it 3] ¥
  133.                 10 70 330 85"
  134.             }
  135.             set it [eval $txt]
  136.             if {[lindex $it 1]} {return}
  137.             set items [lindex $it 2]
  138.             if {[llength $it] == 4 && [lindex $it 3]} {
  139.                 set askForLiAttr 1
  140.             } else {
  141.                 set askForLiAttr 0
  142.             }
  143.             
  144.             if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
  145.                 alertnote "Invalid input: non-negative integer required"
  146.             } elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
  147.                 alertnote "Invalid input: positive integer required"
  148.             } else {
  149.                 break
  150.             }
  151.         }
  152.     } else {
  153.         if {$promptNoisily} {beep}    
  154.         while {[catch {statusPrompt "$ltype list: How many items? " htmlNumberStatusFunc} items]} {
  155.             if {$items == "Cancel all!"} {message "Cancel"; return}
  156.         }
  157.         if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
  158.             beep; message "Invalid input: non-negative integer required."; return
  159.         } elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
  160.             beep; message "Invalid input: positive integer required."; return
  161.         }
  162.         if {(([llength $optatts] && $askForMore) || [llength $usedatts]) && $items} {
  163.             if {$promptNoisily} {beep}    
  164.             while {[catch {statusPrompt "Ask for attributes for each $lipr? ¥[n¥] " ¥
  165.             htmlStatusAskYesOrNo} v]} {
  166.                 if {$v == "Cancel all!"} {message "Cancel"; return}
  167.             }
  168.             if {$v == "yes"} {
  169.                 set askForLiAttr 1
  170.             } else {
  171.                 set askForLiAttr 0
  172.             }
  173.         } else {
  174.             set askForLiAttr 0
  175.         }
  176.     }
  177.     return [list $items $askForLiAttr]
  178. }
  179.     
  180.  
  181. # Lists: Puts <cr>s before and after a list, inserts <li>, leaves the
  182. # insertion point there.  If anything is selected, makes it the first item.
  183. proc htmlBuildList {ltype {liattr ""} {listattr ""}} {
  184.     global HTMLmodeVars 
  185.     global htmlCurSel
  186.     global htmlIsSel
  187.     
  188.     set useTabMarks $HTMLmodeVars(useTabMarks)
  189.     set containers $HTMLmodeVars(lidtAreContainers)
  190.     
  191.     set listStr [htmlListQuestions $ltype $liattr LI]
  192.     if {![llength $listStr]} {
  193.         return
  194.     } else {
  195.         set items [lindex $listStr 0]
  196.         set askForLiAttr [lindex $listStr 1]
  197.     }
  198.  
  199.     # If zero list items, just make an htmlBuildCR2Elem
  200.     if {$items == 0} {
  201.         htmlBuildCR2Elem $ltype $listattr
  202.         return
  203.     }
  204.     
  205.     htmlGetSel
  206.     set sel $htmlCurSel
  207.     set IsSel $htmlIsSel
  208.     set text [htmlOpenCR 1]
  209.     if {$containers} {
  210.         set text1 "[htmlOpenElem $ltype $listattr]¥r"
  211.         if {$text1 == "¥r"} {return}
  212.         append text $text1
  213.         if {$askForLiAttr} {
  214.             set text1 [htmlOpenElem LI $liattr]
  215.         } else {
  216.             set text1 [htmlOpenElem LI NOATTR]
  217.         }
  218.         if {$text1 == ""} {return}
  219.         append text $text1
  220.         if {$IsSel} {    
  221.             append text "${sel}[htmlCloseElem LI]"
  222.             set currpos [expr [getPos] + [string length $text]]
  223.         } else {
  224.             set currpos [expr [getPos] + [string length $text]]
  225.             append text [htmlCloseElem LI]
  226.         }
  227.         for {set i 1} {$i < $items} {incr i} {
  228.             append text "¥r"
  229.             if {$askForLiAttr} {
  230.                 set text1 [htmlOpenElem LI $liattr]
  231.             } else {
  232.                 set text1 [htmlOpenElem LI NOATTR]
  233.             }
  234.             if {$text1 == ""} {return}
  235.             append text $text1
  236.             if {$i == 1 && $IsSel} {
  237.                 set currpos [expr [getPos] + [string length $text]]
  238.             } elseif {$useTabMarks} {
  239.                 append text "･"
  240.             }
  241.             append text [htmlCloseElem LI]
  242.         }
  243.     } else {
  244.         set text1 [htmlOpenElem $ltype $listattr]
  245.         if {$text1 == ""} {return}
  246.         append text $text1
  247.         append text "¥r"
  248.         if {$askForLiAttr} {
  249.             set text1 [htmlOpenElem LI $liattr]
  250.         } else {
  251.             set text1 [htmlOpenElem LI NOATTR]
  252.         }
  253.         if {$text1 == ""} {return}
  254.         append text $text1
  255.         if {$IsSel} {        
  256.             append text $sel 
  257.         } 
  258.         set currpos [expr [getPos] + [string length $text]]
  259.         for {set i 1} {$i < $items} {incr i} {
  260.             append text "¥r"
  261.             if {$askForLiAttr} {
  262.                 set text1 [htmlOpenElem LI $liattr]
  263.             } else {
  264.                 set text1 [htmlOpenElem LI NOATTR]
  265.             }
  266.             if {$text1 == ""} {return}
  267.             append text $text1
  268.             if {$useTabMarks} {append text "･"}
  269.         }
  270.     }
  271.     append text "¥r[htmlCloseElem $ltype]¥r¥r"
  272.     if {$useTabMarks} {append text "･"}
  273.     if {$IsSel} { deleteSelection }
  274.     
  275.     insertText $text
  276.     goto $currpos
  277. }
  278.  
  279.  
  280. # Add list entry.  If there is a selection, make it the entry.
  281.  
  282. proc htmlElemListEntry {liattr} {
  283.     global htmlCurSel htmlIsSel HTMLmodeVars
  284.     
  285.     set containers $HTMLmodeVars(lidtAreContainers)
  286.     set useTabMarks $HTMLmodeVars(useTabMarks)
  287.     htmlGetSel
  288.     set sel $htmlCurSel
  289.     set isSel $htmlIsSel
  290.     set text [htmlOpenCR]
  291.     set text1 [htmlOpenElem LI $liattr]
  292.     if {$text1 == ""} {return}
  293.     append text $text1
  294.     if {$isSel} { deleteSelection }
  295.     if {$containers} {
  296.         if {$isSel} { 
  297.             insertText $text "${sel}" [htmlCloseElem LI]
  298.         } else {
  299.             set currpos [expr [getPos] + [string length $text]]
  300.             append text [htmlCloseElem LI]
  301.             if {$useTabMarks} { append text "･"}
  302.             insertText $text
  303.             goto $currpos
  304.         }
  305.     } else {
  306.         insertText $text $sel
  307.     }
  308. }
  309.  
  310. # Make list items from selction.
  311. proc htmlMakeList {} {
  312.     global HTMLmodeVars
  313.     
  314.     set isContainer $HTMLmodeVars(lidtAreContainers)
  315.     
  316.     if {![isSelection]} {
  317.         beep
  318.         message "No selection."
  319.         return
  320.     }
  321.     
  322.     set values [dialog -w 220 -h 80 ¥
  323.     -t "Each item begins with:" 10 10 160 25 -e "*" 170 10 200 25 ¥
  324.     -b OK 20 45 85 65 -b Cancel 105 45 170 65]
  325.     
  326.     if {[lindex $values 2]} {return}
  327.     set itemStr [string trim [lindex $values 0]]
  328.     
  329.     if {![string length $itemStr]} {
  330.         beep
  331.         message "You must give a string which each item begins with."
  332.         return
  333.     }
  334.     set startPos [getPos]
  335.     set endPos [selEnd]
  336.     if {[catch {search -s -f 1 -i 0 -r 0 -m 0 $itemStr $startPos} res] || ¥
  337.     [lindex $res 1] > $endPos} {
  338.         beep 
  339.         message "No list item in selection."
  340.         return
  341.     }
  342.     # Check that the selections begins with a list item.
  343.     set preText [getText $startPos [lindex $res 0]]
  344.     regexp {[ ¥t¥r]*} $preText test
  345.     if {$test != $preText} {
  346.         beep
  347.         message "There is some text before the first list item."
  348.         return
  349.     }
  350.     # Get each list item.
  351.     set startPos [lindex $res 1]
  352.     while {![catch {search -s -f 1 -i 0 -r 0 -m 0 $itemStr $startPos} res2] && ¥
  353.     [lindex $res2 1] <= $endPos} {
  354.         set text2 [string trimleft [string trimright [getText $startPos [lindex $res2 0]] "¥r"]]
  355.         append text "¥r<[htmlSetCase LI]>$text2"
  356.         if {$isContainer} {append text [htmlCloseElem LI]}
  357.         set startPos [lindex $res2 1]
  358.     }
  359.     set text2 [string trimleft [string trimright [getText $startPos $endPos] "¥r"]]
  360.     append text "¥r<[htmlSetCase LI]>$text2"
  361.     if {$isContainer} {append text [htmlCloseElem LI]}
  362.     append text "¥r"
  363.     replaceText [getPos] [selEnd] [string trimleft $text "¥r"]
  364. }
  365.  
  366.  
  367. # Discursive Lists (term and description elems)
  368. #
  369. # The selection becomes the *description* (*not* the term)
  370.  
  371. # Build a discursive list
  372. proc htmlBuildDiscList {} {
  373.     global htmlCurSel
  374.     global htmlIsSel
  375.     global HTMLmodeVars 
  376.  
  377.     set containers $HTMLmodeVars(lidtAreContainers)
  378.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  379.     
  380.     set listStr [htmlListQuestions DL DT "DT and DD"]
  381.     if {![llength $listStr]} {
  382.         return
  383.     } else {
  384.         set dlEntries [lindex $listStr 0]
  385.         set askForLiAttr [lindex $listStr 1]
  386.     }
  387.     if {$askForLiAttr} {
  388.         set liattr ""
  389.     } else {
  390.         set liattr NOATTR
  391.     }
  392.     
  393.     htmlGetSel
  394.     set Sel $htmlCurSel
  395.     set text [htmlOpenCR 1]
  396.     
  397.     if {$containers} {
  398.         set text1 "[htmlOpenElem DL]¥r"
  399.         if {$text1 == "¥r"} {return}
  400.         append text $text1
  401.         # the first entry
  402.         set text1 [htmlOpenElem DT $liattr]
  403.         if {$text1 == ""} {return}
  404.         append text $text1
  405.         set currpos [expr [getPos] + [string length $text]]
  406.         append text "[htmlCloseElem DT]¥t"
  407.         set text1 [htmlOpenElem DD $liattr]
  408.         if {$text1 == ""} {return}
  409.         append text $text1
  410.         if {$htmlIsSel} {
  411.             append text $Sel
  412.         } elseif {$useTabMarks} {
  413.             append text "･"
  414.         }
  415.         append text [htmlCloseElem DD]
  416.         # the rest of the entries
  417.         for {set i 1} {$i < $dlEntries} {incr i} {
  418.             append text "¥r"
  419.             set text1 [htmlOpenElem DT $liattr]
  420.             if {$text1 == ""} {return}
  421.             append text $text1
  422.             if {$useTabMarks} { append text "･" }
  423.             append text [htmlCloseElem DT] 
  424.             append text "¥t"
  425.             set text1 [htmlOpenElem DD $liattr]
  426.             if {$text1 == ""} {return}
  427.             append text $text1
  428.             if {$useTabMarks} { append text "･" }
  429.             append text [htmlCloseElem DD] 
  430.         }
  431.         
  432.         if {$useTabMarks} {append text "･"}
  433.         
  434.     } else {
  435.         set text1 [htmlOpenElem DL]
  436.         if {$text1 == ""} {return}
  437.         append text $text1
  438.         append text "¥r"
  439.  
  440.         # The first entry
  441.         set text1 [htmlOpenElem DT $liattr]
  442.         if {$text1 == ""} {return}
  443.         append text $text1
  444.     
  445.         set currpos [expr [getPos] + [string length $text]]
  446.         append text "¥t"
  447.         set text1 [htmlOpenElem DD $liattr]
  448.         if {$text1 == ""} {return}
  449.         append text $text1
  450.     
  451.         if {$htmlIsSel} {
  452.             append text $Sel
  453.         }
  454.         if {$useTabMarks} {append text "･"}        
  455.     
  456.         # Now for the rest of the entries
  457.         for {set i 1} {$i < $dlEntries} {incr i} {
  458.             append text "¥r"
  459.             set text1 [htmlOpenElem DT $liattr]
  460.             if {$text1 == ""} {return}
  461.             append text $text1
  462.             
  463.             if {$useTabMarks} {append text "･"}
  464.             append text "¥t"
  465.             set text1 [htmlOpenElem DD $liattr]
  466.             if {$text1 == ""} {return}
  467.             append text $text1
  468.         
  469.             if {$useTabMarks} {append text "･"}
  470.         }
  471.     }
  472.     append text "¥r[htmlCloseElem DL]¥r¥r"
  473.     if {$useTabMarks} {append text "･"}
  474.     if {$htmlIsSel} { deleteSelection }
  475.     insertText $text
  476.     goto $currpos
  477. }
  478.  
  479. # Add an individual entry to a discursive list
  480. proc htmlElemDiscEntry {} {
  481.     global htmlCurSel htmlIsSel
  482.     global HTMLmodeVars
  483.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  484.     set containers $HTMLmodeVars(lidtAreContainers)
  485.     
  486.     htmlGetSel
  487.     set Sel $htmlCurSel
  488.     set text [htmlOpenCR]
  489.  
  490.     if {$containers} {
  491.         set text1 [htmlOpenElem DT]
  492.         if {$text1 == ""} {return}
  493.         append text $text1
  494.         set currpos [expr [getPos] + [string length $text]]
  495.         append text "[htmlCloseElem DT]¥t"
  496.         set text1 [htmlOpenElem DD]
  497.         if {$text1 == ""} {return}
  498.         append text $text1
  499.         if {$htmlIsSel} {
  500.             append text ${Sel}
  501.         } elseif {$useTabMarks} {append text "･"}
  502.         append text [htmlCloseElem DD]
  503.         if {$useTabMarks} {append text "･"}
  504.         if {$htmlIsSel} { deleteSelection }
  505.         insertText $text [htmlCloseCR]
  506.     } else {
  507.         set text1 [htmlOpenElem DT]    
  508.         if {$text1 == ""} {return}
  509.         append text $text1
  510.         set currpos [expr [getPos] + [string length $text]]
  511.         append text "¥t"
  512.         set text1 [htmlOpenElem DD]
  513.         if {$text1 == ""} {return}
  514.         append text $text1
  515.     
  516.         if {$htmlIsSel} {
  517.             append text $Sel
  518.         }
  519.         if {$useTabMarks} {append text "･"}
  520.         if {$htmlIsSel} { deleteSelection }
  521.         insertText $text [htmlCloseCR]
  522.     }
  523.     goto $currpos
  524. }
  525.  
  526.  
  527. # Different Input fields
  528.  
  529. proc htmlBuildInputElem {inputelem {cr1 0} {cr2 1}} {
  530.     htmlBuildOpening "INPUT TYPE=¥"${inputelem}¥"" $cr1 $cr2 $inputelem
  531. }
  532.  
  533.  
  534. # Table template. If there is any selection it is put in the first cell.
  535. proc htmlTableTemplate {} {
  536.     global htmlCurSel htmlIsSel HTMLmodeVars
  537.     
  538.     set useTabMarks $HTMLmodeVars(useTabMarks)
  539.     
  540.     set values {"" "" 0 0 0 0 "No value" "No value"}
  541.     set rows ""
  542.     set cols ""
  543.     set trAttrs [htmlGetChoices TR]
  544.     foreach w $trAttrs {
  545.         if {[string match "VALIGN=*" $w]} {
  546.             lappend valignMenu  [string range $w 7 end]
  547.         }    
  548.     }
  549.     foreach w $trAttrs {
  550.         if {[string match "ALIGN=*" $w]} {
  551.             lappend alignMenu  [string range $w 6 end]
  552.         }    
  553.     }
  554.     while {![htmlIsPositiveInteger $rows] || ![htmlIsPositiveInteger $cols]} {
  555.         
  556.         set box "-t {Table template} 50 10 200 25 ¥
  557.         -p 50 26 150 27 ¥
  558.         -t {Number of rows} 10 40 150 55  -e [list [lindex $values 0]] 160 40 180 55 ¥
  559.         -t {Number of columns} 10 65 150 80 -e [list [lindex $values 1]] 160 65 180 80 ¥
  560.         -c {Table headers in first row} [lindex $values 2] 10 90 250 105 ¥
  561.         -c {Table headers in first column} [lindex $values 3] 10 110 250 135 ¥
  562.         -t {Alignment for every row} 10 150 200 165 ¥
  563.         -b OK 20 230 85 250 -b Cancel 105 230 170 250"
  564.         
  565.         lappend box -t VALIGN= 10 175 70 190 ¥
  566.         -m [concat [list [lindex $values 6] "No value"] $valignMenu] 80 175 175 190 ¥
  567.         -t ALIGN= 10 200 60 215 ¥
  568.         -m [concat [list [lindex $values 7] "No value"] $alignMenu] 80 200 175 215 
  569.         set values [eval [concat dialog -w 230 -h 260 $box]]
  570.         
  571.         # Cancel?
  572.         if {[lindex $values 5] } {return}
  573.         
  574.         set rows [lindex $values 0]
  575.         set cols [lindex $values 1]
  576.         set THrow [lindex $values 2]
  577.         set THcol [lindex $values 3]
  578.         set valign [lindex $values 6]
  579.         set align [lindex $values 7]
  580.         
  581.         set trOpen "<[htmlSetCase TR]"
  582.         if {$valign != "No value"} {
  583.             append trOpen " " [htmlSetCase VALIGN=[htmlAddQuotes $valign]]
  584.         }
  585.         if {$align != "No value"} {
  586.             append trOpen " " [htmlSetCase ALIGN=[htmlAddQuotes $align]]
  587.         }
  588.         append trOpen ">"
  589.         if {![htmlIsPositiveInteger $rows] || ![htmlIsPositiveInteger $cols] } {
  590.             alertnote "The number of rows and columns must be specified."
  591.         }
  592.     }
  593.     
  594.     set tableOpen [htmlOpenElem TABLE]
  595.     if {![string length $tableOpen]} {return}
  596.     
  597.     htmlGetSel
  598.     if {$htmlIsSel} {deleteSelection}
  599.     
  600.     set text [htmlOpenCR 1]
  601.     append text "¥r" $tableOpen "¥r"
  602.     
  603.     for {set i 1} {$i <= $rows} {incr i} {
  604.         append text "¥r$trOpen¥r"
  605.         for {set j 1} {$j <= $cols} {incr j} {
  606.             # Put TH in first row or column?
  607.             if {$i == 1 && $THrow || $j == 1 && $THcol} {
  608.                 set cell [htmlSetCase TH]
  609.             } else {
  610.                 set cell [htmlSetCase TD]
  611.             }
  612.             append text "<$cell>"
  613.             if {$i == 1 && $j == 1} {
  614.                 if {$htmlIsSel} {
  615.                     append text $htmlCurSel
  616.                 } else {
  617.                     set curPos [expr [getPos] + [string length $text]]
  618.                 }
  619.             } elseif {$htmlIsSel && ( $i == 1 && $j == 2 || $i == 2 && $cols == 1 )} {
  620.                 set curPos [expr [getPos] + [string length $text]]
  621.             } elseif {$useTabMarks} {
  622.                 append text "･"
  623.             }    
  624.             append text [htmlCloseElem $cell]
  625.         }
  626.         append text "¥r[htmlCloseElem TR]¥r"
  627.     }
  628.     append text "¥r[htmlCloseElem TABLE]¥r¥r"
  629.     if {$useTabMarks && ($rows > 1 || $cols > 1 || !$htmlIsSel)} {append text "･"}
  630.     insertText $text
  631.     goto $curPos
  632. }
  633.  
  634.  
  635. # Take table rows in a selection and remove the TR, TD and TH elements and
  636. # put tabs between the elements.
  637. proc htmlrowsToTabs {} {
  638.     if {![isSelection]} {
  639.         beep
  640.         message "No selection."
  641.         return
  642.     }
  643.     
  644.     set startPos [getPos]
  645.     set endPos [selEnd]
  646.     if {[catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ ¥t¥r]+[^>]*>|>)} $startPos} res] || ¥
  647.     [lindex $res 1] > $endPos} {
  648.         beep 
  649.         message "No table row in selection."
  650.         return
  651.     }
  652.     # Check that the selections begins with a table row.
  653.     set preText [getText $startPos [lindex $res 0]]
  654.     regexp {[ ¥t¥r]*} $preText test
  655.     if {$test != $preText} {
  656.         beep
  657.         message "First part of selection is not in a table row."
  658.         return
  659.     }
  660.     # Extract each table row.
  661.     set startPos [lindex $res 1]
  662.     while {![catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ ¥t¥r]+[^>]*>|>)} $startPos} res2] && ¥
  663.     [lindex $res2 1] <= $endPos} {
  664.         set text2 [getText $startPos [lindex $res2 0]]
  665.         regsub -all "¥[¥t¥r¥]+" $text2 " " text2
  666.         append text [string trim $text2] "¥r"
  667.         set startPos [lindex $res2 1]
  668.     }
  669.     set text2 [getText $startPos $endPos]
  670.     regsub -all "¥[¥t¥r¥]+" $text2 " " text2
  671.     append text [string trim $text2]
  672.     
  673.     # Check that there is nothing after the last table row.
  674.     if {![catch {search -s -f 1 -i 1 -r 1 -m 0 {</TR>} $startPos} res] ¥
  675.     && [lindex $res 1] <= $endPos} {
  676.         set preText [getText [lindex $res 1] $endPos]
  677.         regexp {[ ¥t¥r]*} $preText test
  678.         if {$test != $preText} {
  679.             beep
  680.             message "Last part of selection not in a table row."
  681.             return
  682.         }
  683.     }
  684.     # Make the transformation.
  685.     foreach ln [split $text "¥r"] {
  686.         if {![string length $ln]} continue
  687.         regsub -all {> +<} $ln "><" ln
  688.         regsub -all {<(t|T)(h|H|d|D)([ ]+[^>]*>|>)} $ln "¥t" ln
  689.         regsub {    } $ln "" ln
  690.         regsub -all {</(t|T)(h|H|d|D|r|R)>} $ln "" ln
  691.         append out "$ln¥r"
  692.     }
  693.     replaceText [getPos] [selEnd] $out
  694. }
  695.  
  696. # Convert tab-delimited format to table rows.
  697. # First row and first coloumn can optionally consist of table headers.
  698. proc htmltabsToRows {} {
  699.     global HTMLmodeVars
  700.     
  701.     if {![isSelection]} {
  702.         beep
  703.         message "No selection."
  704.         return
  705.     }
  706.     
  707.     append oelem "¥r" [htmlOpenElem TR] "¥r"
  708.     if {$oelem == "¥r¥r"} {return}
  709.     
  710.     if {!$HTMLmodeVars(useBigWindows)} {
  711.         if {$HTMLmodeVars(promptNoisily)} {beep}
  712.         while {[catch {statusPrompt "Table headers in first row? ¥[n¥] " ¥
  713.         htmlStatusAskYesOrNo} v]} {
  714.             if {$v == "Cancel all!"} {message "Cancel"; return}
  715.         }
  716.         if {$v == "yes"} {
  717.             set THrow 1
  718.         } else {
  719.             set THrow 0
  720.         }
  721.         if {$HTMLmodeVars(promptNoisily)} {beep}
  722.         while {[catch {statusPrompt "Table headers in first column? ¥[n¥] " ¥
  723.         htmlStatusAskYesOrNo} v]} {
  724.             if {$v == "Cancel all!"} {message "Cancel"; return}
  725.         }            
  726.         if {$v == "yes"} {
  727.             set THcol 1
  728.         } else {
  729.             set THcol 0
  730.         }
  731.     } else {
  732.         set THbox [dialog -w 230  -h 105 -t "Put table headers in" 10 10 240 30 ¥
  733.         -c "first row" 0 10 40 100 60 -c "first column" 0 110 40 220 60 ¥
  734.         -b OK 20 75 85 95 -b Cancel 105 75 170 95]
  735.         if {[lindex $THbox 3]} {return}
  736.         set THrow [lindex $THbox 0]
  737.         set THcol [lindex $THbox 1]
  738.     }
  739.     
  740.     set out [htmlOpenCR]
  741.     set i 1
  742.     foreach ln [split [string trimright [getSelect] "¥r"] "¥r"] {
  743.         if {![string length $ln]} {
  744.             append out "$oelem[htmlCloseElem TR]¥r"
  745.         } else {
  746.             # Should there be headers in the first row?
  747.             if {$i == 1 && $THrow} {
  748.                 set cell TH
  749.             } else {
  750.                 set cell TD
  751.             }
  752.             # Should there be headers in the first column?
  753.             if {$THcol || ($i == 1 && $THrow)} {
  754.                 set fcell TH
  755.             } else {
  756.                 set fcell TD
  757.             }
  758.             regsub -all {    } $ln [htmlSetCase "</$cell><$cell>"] ln
  759.             if {$THcol} {
  760.                 regsub {[tT][dDhH]} $ln [htmlSetCase TH] ln
  761.             }
  762.             append out "$oelem<[htmlSetCase $fcell]>$ln"
  763.             # Add cell or fcell closing, depending on if there is more than one cell.
  764.             if {![regexp [htmlCloseElem $fcell] $ln]} {
  765.                 append out [htmlCloseElem $fcell]
  766.             } else {
  767.                 append out [htmlCloseElem $cell]
  768.             }
  769.             append out "¥r[htmlCloseElem TR]¥r"
  770.             incr i
  771.         }
  772.     }
  773.     replaceText [getPos] [selEnd] $out
  774. }
  775.  
  776.  
  777. proc htmlElemComment {} {
  778.     global htmlCurSel
  779.     global htmlIsSel
  780.     global HTMLmodeVars
  781.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  782.     set commentPreString    $HTMLmodeVars(prefixString)
  783.     set commentSufString    $HTMLmodeVars(suffixString)
  784.  
  785.     htmlGetSel
  786.     if {$htmlIsSel} { deleteSelection }
  787.     set text "[htmlOpenCR]${commentPreString}$htmlCurSel"
  788.     set currpos [expr [getPos] + [string length $text]]
  789.     append text $commentSufString [htmlCloseCR]
  790.     if {!$htmlIsSel && $useTabMarks} {append text "･"}
  791.     insertText $text
  792.     if {!$htmlIsSel}    {
  793.         goto $currpos
  794.     }
  795. }
  796.  
  797.  
  798. #
  799. # Template for new file: HTML, TITLE, HEAD, BODY or FRAMESET
  800. # Optionally input BASE, LINK, ISINDEX, META and SCRIPT in HEAD.
  801. # We do not put in a DOCTYPE line.
  802. proc htmlNewTemplate {doctype} {
  803.     global htmlCurSel htmlIsSel HTMLmodeVars htmlHeadElements1 htmlHeadElements3 htmlPackageToUse
  804.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  805.     set footers $HTMLmodeVars(footers)
  806.     set headelems [set htmlHeadElements$htmlPackageToUse]
  807.     
  808.     set bodyText ""
  809.     # If the window is not empty, either delete text or put it in the body.
  810.     if {![htmlIsEmptyFile]} {
  811.         set delBox [dialog -w 320 -h 90 -t "Nonempty window. Do you want to put the text¥
  812.         in the document's BODY, or delete it?" 10 10 310 50 ¥
  813.         -b "Put in BODY" 20 60 120 80 -b Delete 140 60 205 80 -b Cancel 225 60 290 80]
  814.         if {[lindex $delBox 1]} {
  815.             deleteText 0 [maxPos]
  816.         } elseif {[lindex $delBox 2]} {
  817.             return
  818.         } else {
  819.             set bodyText "[getText 0 [maxPos]]¥r"
  820.         }
  821.     } 
  822.     
  823.     if {$doctype == "FRAMESET"} {
  824.         set htxt "New document with frames"
  825.     } else {
  826.         set htxt "New document"
  827.     }
  828.     # Building footer menu.
  829.     foreach f $footers {
  830.         lappend foot [file tail $f]
  831.     }
  832.     set footmenu {"No footer"}
  833.     if {[info exists foot]} {
  834.         set footmenu [concat $footmenu $foot]
  835.     }
  836.     
  837.     set docTitle ""
  838.     set inHead {0 0 ""}
  839.     foreach elem $headelems {
  840.         lappend inHead 0
  841.     }
  842.     lappend inHead "No footer"
  843.     while {![string length $docTitle]} {
  844.         
  845.         # Construct the dialog box.
  846.         set box "-t [list $htxt] 100 10 300 25 -p 100 30 250 31 -t {TITLE} 10 40 60 55 ¥
  847.         -e [list [lindex $inHead 2]] 70 40 390 55 ¥
  848.         -t {Select the elements you want in the document¥'s HEAD} 10 70 390 85"
  849.         set hpos 100
  850.         set i 3
  851.         foreach elem $headelems {
  852.             append box " -c $elem [lindex $inHead $i] 10 $hpos 150 [expr $hpos + 15]"
  853.             incr hpos 20
  854.             incr i
  855.         }
  856.         incr hpos 10
  857.         append box " -t Footer 10 $hpos 80 [expr $hpos + 15] ¥
  858.         -m [list [concat [list [lindex $inHead $i]] $footmenu]] 90 $hpos 250 [expr $hpos + 15]"
  859.         incr hpos 30 
  860.         set inHead [eval [concat dialog -w 400 -h [expr $hpos + 30] ¥
  861.         -b OK 20 $hpos 85 [expr $hpos + 20] ¥
  862.         -b Cancel 110 $hpos 175 [expr $hpos + 20] $box]]
  863.         if {[lindex $inHead 1] } {return}
  864.         set docTitle [string trim [lindex $inHead 2]]
  865.         if {![string length $docTitle]} {
  866.             alertnote "A document title is required."
  867.         }
  868.     }
  869.     
  870.     
  871.     set text [htmlOpenElem HTML]
  872.     if {$text == ""} {return}
  873.     set text1 [htmlOpenElem HEAD]
  874.     if {$text1 == ""} {return}
  875.     append text "¥r¥r${text1}¥r¥r"
  876.     append text "[htmlOpenElem TITLE]${docTitle}[htmlCloseElem TITLE]¥r"
  877.     set hasScript 0
  878.     for {set i 0} {$i < [llength  $headelems]} {incr i} {
  879.         if {[lindex $inHead [expr $i + 3]]} {
  880.             set text1 [htmlOpenElem [lindex $headelems $i]]
  881.             if {$text1 != ""} {
  882.                 append text "¥r${text1}"
  883.                 if {[lindex $headelems $i] == "SCRIPT"} {
  884.                     append text "¥r"
  885.                     set currpos [string length $text]
  886.                     set hasScript 1
  887.                     append text "¥r[htmlCloseElem SCRIPT]"
  888.                 }
  889.             }
  890.         }
  891.     }
  892.     append text "¥r¥r[htmlCloseElem HEAD]¥r¥r"
  893.     
  894.     set text1 [htmlOpenElem $doctype]
  895.     if {$text1 == ""} {return}
  896.     append text "$text1¥r¥r"
  897.     append text $bodyText
  898.     if {!$hasScript} {
  899.         set currpos [string length $text]
  900.     } elseif {$useTabMarks} {
  901.         append text "･"
  902.     }    
  903.     
  904.     # Insert footer.
  905.     set footval [lindex $inHead [expr [llength $headelems] + 3]]
  906.     if {$footval != "No footer"} {
  907.         set footerFile [lindex $footers [lsearch -exact $foot $footval]]
  908.         if {![catch {readFile $footerFile} footText]} {
  909.             append text "¥r¥r$footText"
  910.         } else {
  911.             alertnote "Could not read footer, $footerFile"
  912.         }
  913.     }
  914.     append text "¥r¥r[htmlCloseElem $doctype]¥r¥r[htmlCloseElem HTML]"
  915.     if {![htmlIsEmptyFile]} {deleteText 0 [maxPos]}
  916.     insertText $text
  917.  
  918.     goto $currpos
  919. }
  920.